home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / dll_gen / winfox / dplibobj.ba_ / dplibobj.ba
Text File  |  1995-01-31  |  17KB  |  453 lines
  1. 'DPLIBOBJ.BAS
  2. '1/15/95
  3. 'Digital PowerTOOLS Library for Objects
  4. 'Copyright ⌐ 1995 by Digital PowerTOOLS
  5.  
  6. 'these functions and subroutines are intended ONLY for use
  7. 'in your application; you are not authorized to distribute
  8. 'this source code
  9.  
  10. Type ObjRect
  11.     Left As Integer
  12.     Top As Integer
  13.     right As Integer
  14.     bottom As Integer
  15. End Type
  16.  
  17. Declare Sub GetWindowRect Lib "User" (ByVal hWnd%, lpRect As ObjRect)
  18. Declare Function GetDC% Lib "User" (ByVal hWnd%)
  19. Declare Function ReleaseDC% Lib "User" (ByVal hWnd%, ByVal hDC%)
  20. Declare Sub Rectangle Lib "GDI" (ByVal hDC%, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%)
  21. Declare Function CreateSolidBrush% Lib "GDI" (ByVal crColor&)
  22. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  23. Declare Sub DeleteObject Lib "GDI" (ByVal hObject%)
  24.  
  25. Declare Function FillRect Lib "User" (ByVal hDC As Integer, lpRect As ObjRect, ByVal hBrush As Integer) As Integer
  26. Declare Function AltDeleteObject Lib "GDI" Alias "DeleteObject" (ByVal hObject As Integer) As Integer
  27.  
  28. Sub DoControl3D (Obj As Control, Style, thick)
  29. 'draws 3D shadows effects around a control
  30. 'Style is either "sunken" or "raised"
  31.  
  32. 'use this function in the Paint event of the form
  33.  
  34.     If thick <= 0 Then thick = 1
  35.     If thick > 8 Then thick = 8
  36.     OldMode = Obj.Parent.ScaleMode
  37.     OldWidth = Obj.Parent.DrawWidth
  38.     Obj.Parent.ScaleMode = 3
  39.     Obj.Parent.DrawWidth = 1
  40.     ObjHeight = Obj.Height
  41.     ObjWidth = Obj.Width
  42.     ObjLeft = Obj.Left
  43.     ObjTop = Obj.Top
  44.     
  45.     Select Case LCase$(Style)
  46.         Case "sunken":
  47.             TLshade = QBColor(8)
  48.             BRshade = QBColor(15)
  49.         Case "raised":
  50.             TLshade = QBColor(15)
  51.             BRshade = QBColor(8)
  52.         End Select
  53.         For i = 1 To thick
  54.             CurLeft = ObjLeft - i
  55.             CurTop = ObjTop - i
  56.             CurWide = ObjWidth + (i * 2) - 1
  57.             CurHigh = ObjHeight + (i * 2) - 1
  58.             Obj.Parent.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  59.             Obj.Parent.Line -Step(0, CurHigh), BRshade
  60.             Obj.Parent.Line -Step(-CurWide, 0), BRshade
  61.             Obj.Parent.Line -Step(0, -CurHigh), TLshade
  62.             Next i
  63.         If thick > 2 Then
  64.             CurLeft = ObjLeft - thick - 1
  65.             CurTop = ObjTop - thick - 1
  66.             CurWide = ObjWidth + ((thick + 1) * 2) - 1
  67.             CurHigh = ObjHeight + ((thick + 1) * 2) - 1
  68.             Obj.Parent.Line (CurLeft, CurTop)-Step(CurWide, 0), QBColor(0)
  69.             Obj.Parent.Line -Step(0, CurHigh), QBColor(0)
  70.             Obj.Parent.Line -Step(-CurWide, 0), QBColor(0)
  71.             Obj.Parent.Line -Step(0, -CurHigh), QBColor(0)
  72.             End If
  73.     Obj.Parent.ScaleMode = OldMode
  74.     Obj.Parent.DrawWidth = OldWidth
  75. End Sub
  76.  
  77. Sub DoEtchedFrame (Obj As PictureBox, TextMsg, Just, ColorVal&, TextStyle, ObjStyle)
  78. 'makes a PictureBox look like a stylized Frame (GroupBox)
  79. 'PictureBoxes can contain option buttons
  80.  
  81. 'Just is "left", "right", or "center"
  82. 'TextStyle is either "sunken" or "raised"
  83. 'ObjStyle is either "sunken" or "raised"
  84.  
  85. 'use this function in the Paint event of the form
  86.     
  87.     Obj.BorderStyle = 0
  88.     Obj.AutoRedraw = True
  89.     OldScaleMode = Obj.ScaleMode
  90.     Obj.ScaleMode = 1
  91.     OldDrawMode = Obj.DrawWidth
  92.     Obj.DrawWidth = 1
  93.     
  94.     TxLen% = Obj.TextWidth(TextMsg)
  95.     Obj.ForeColor = ColorVal
  96.     Cur1Left% = Obj.ScaleLeft + 15
  97.     Cur1Top% = Obj.ScaleTop + (Obj.TextHeight("A") / 2)
  98.     Cur1Wide% = Obj.ScaleWidth - 30
  99.     Cur1High% = (Obj.ScaleHeight - 30)
  100.     Cur2Left% = Obj.ScaleLeft
  101.     Cur2Top% = Obj.ScaleTop + ((Obj.TextHeight("A") / 2) - 10)
  102.     Cur2Wide% = Obj.ScaleWidth - 15
  103.     Cur2High% = (Obj.ScaleHeight - 10)
  104.     
  105.     Select Case LCase$(Just)
  106.         Case "left"
  107.             Left1Start% = Cur1Left%
  108.             Left1End% = 120
  109.             Right1Start% = Left1End% + TxLen% + 240
  110.             Right1End% = Cur1Wide%
  111.             Left2Start% = Cur2Left%
  112.             Left2End% = 110
  113.             Right2Start% = Left2End% + TxLen% + 240
  114.             Right2End% = Cur2Wide%
  115.             Xpos% = 240
  116.             Ypos% = 0
  117.         Case "right"
  118.             Left1Start% = Cur1Left%
  119.             Left1End% = (Cur1Wide% - TxLen%) - 350
  120.             Right1Start% = Cur1Wide% - 120
  121.             Right1End% = Cur1Wide%
  122.             Left2Start% = Cur2Left%
  123.             Left2End% = (Cur2Wide% - TxLen%) - 350
  124.             Right2Start% = Cur2Wide% - 130
  125.             Right2End% = Cur2Wide%
  126.             Xpos% = Left1End% + 120
  127.             Ypos% = 0
  128.         Case "center"
  129.             Left1Start% = Cur1Left%
  130.             Left1End% = (Cur1Wide% - (TxLen% + 240)) / 2
  131.             Right1Start% = Cur1Wide% - Left1End%
  132.             Right1End% = Cur1Wide%
  133.             Left2Start% = Cur2Left%
  134.             Left2End% = (Cur2Wide% - (TxLen% + 240)) / 2
  135.             Right2Start% = Cur2Wide% - Left2End%
  136.             Right2End% = Cur2Wide%
  137.             Xpos% = Left1End% + 120
  138.             Ypos% = 0
  139.         End Select
  140.     
  141.     If LCase$(TextStyle) = "sunken" Then
  142.            Obj.CurrentX = Xpos% + 15
  143.            Obj.CurrentY = Ypos% + 15
  144.            Obj.ForeColor = QBColor(8)
  145.            Obj.Print TextMsg
  146.         End If
  147.     If LCase$(TextStyle) = "raised" Then
  148.            Obj.CurrentX = Xpos% - 15
  149.            Obj.CurrentY = Ypos% - 15
  150.            Obj.ForeColor = QBColor(15)
  151.            Obj.Print TextMsg
  152.            Obj.CurrentX = Xpos% + 15
  153.            Obj.CurrentY = Ypos% + 15
  154.            Obj.ForeColor = QBColor(8)
  155.            Obj.Print TextMsg
  156.         End If
  157.     Obj.CurrentX = Xpos%
  158.     Obj.CurrentY = Ypos%
  159.     Obj.ForeColor = ColorVal
  160.     Obj.Print TextMsg
  161.     
  162.     Select Case LCase$(ObjStyle)
  163.         Case "sunken"
  164.             TLshade = QBColor(15)
  165.             BRshade = QBColor(8)
  166.         Case "raised"
  167.             TLshade = QBColor(8)
  168.             BRshade = QBColor(15)
  169.         End Select
  170.             
  171.     Obj.Line (Left1Start%, Cur1Top%)-(Left1End%, Cur1Top%), TLshade
  172.     Obj.Line (Right1Start%, Cur1Top%)-(Right1End%, Cur1Top%), TLshade
  173.     Obj.Line (Right1End%, Cur1Top%)-(Right1End%, Cur1High%), BRshade
  174.     Obj.Line (Right1End%, Cur1High%)-(Left1Start%, Cur1High%), BRshade
  175.     Obj.Line (Left1Start%, Cur1High%)-(Left1Start%, Cur1Top%), TLshade
  176.     Obj.Line (Left2Start%, Cur2Top%)-(Left2End%, Cur2Top%), BRshade
  177.     Obj.Line (Right2Start%, Cur2Top%)-(Right2End%, Cur2Top%), BRshade
  178.     Obj.Line (Right2End%, Cur2Top%)-(Right2End%, Cur2High%), TLshade
  179.     Obj.Line (Right2End%, Cur2High%)-(Left2Start%, Cur2High%), TLshade
  180.     Obj.Line (Left2Start%, Cur2High%)-(Left2Start%, Cur2Top%), BRshade
  181.     
  182.     Obj.ScaleMode = OldScaleMode
  183.     Obj.DrawWidth = OldDrawMode
  184.     Obj.AutoRedraw = False
  185. End Sub
  186.  
  187. Sub DoForm3D (TheForm As Form, Style, thick, Distance)
  188. 'draws 3D shadow effects on a form
  189. 'can be called with different values for a variety of effects
  190. 'Style is either "sunken" or "raised"
  191.  
  192. 'use this function in the Paint event of the form
  193.  
  194.     If thick <= 0 Then thick = 1
  195.     If thick > 8 Then thick = 8
  196.     If Distance < 0 Then Distance = 0
  197.     If Distance > 8 Then Distance = 8
  198.     OldMode = TheForm.ScaleMode
  199.     OldWidth = TheForm.DrawWidth
  200.     TheForm.ScaleMode = 3
  201.     TheForm.DrawWidth = 1
  202.     FormHeight = TheForm.ScaleHeight
  203.     FormWidth = TheForm.ScaleWidth
  204.     FormLeft = TheForm.ScaleLeft
  205.     FormTop = TheForm.ScaleTop
  206.     
  207.     Select Case LCase$(Style)
  208.         Case "sunken":
  209.             TLshade = QBColor(8)
  210.             BRshade = QBColor(15)
  211.         Case "raised":
  212.             TLshade = QBColor(15)
  213.             BRshade = QBColor(8)
  214.         End Select
  215.     Select Case TheForm.BorderStyle
  216.         Case 0:
  217.             OLshade = QBColor(0)
  218.             TheForm.Line (0, 0)-(FormWidth, 0), OLshade
  219.             TheForm.Line (0, 0)-(0, FormHeight), OLshade
  220.             TheForm.Line (FormWidth - 1, 0)-(FormWidth - 1, FormHeight + 1), OLshade
  221.             TheForm.Line (0, FormHeight - 1)-(FormWidth, FormHeight - 1), OLshade
  222.             For i = 1 To thick
  223.                 CurLeft = FormLeft + i + Distance
  224.                 CurTop = FormTop + i + Distance
  225.                 CurWide = FormWidth - (i + Distance) * 2 - 1
  226.                 CurHigh = FormHeight - (i + Distance) * 2 - 1
  227.                 TheForm.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  228.                 TheForm.Line -Step(0, CurHigh), BRshade
  229.                 TheForm.Line -Step(-CurWide, 0), BRshade
  230.                 TheForm.Line -Step(0, -CurHigh), TLshade
  231.                 Next i
  232.         Case 1 To 3:
  233.             If Thickness = 1 Then
  234.                 TheForm.Line (thick, thick)-(FormWidth - thick, thick), TLshade
  235.                 TheForm.Line (thick, thick)-(thick, FormHeight - thick), TLshade
  236.                 TheForm.Line (FormWidth - thick, thick)-(FormWidth - thick, FormHeight - thick + 1), BRshade
  237.                 TheForm.Line (thick, FormHeight - thick)-(FormWidth - thick, FormHeight - thick), BRshade
  238.                 Else
  239.             For i = 1 To thick
  240.                 CurLeft = FormLeft + i - 1 + Distance
  241.                 CurTop = FormTop + i - 1 + Distance
  242.                 CurWide = FormWidth - (i + Distance) * 2 + 1
  243.                 CurHigh = FormHeight - (i + Distance) * 2 + 1
  244.                 TheForm.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  245.                 TheForm.Line -Step(0, CurHigh), BRshade
  246.                 TheForm.Line -Step(-CurWide, 0), BRshade
  247.                 TheForm.Line -Step(0, -CurHigh), TLshade
  248.                 Next i
  249.                 End If
  250.         End Select
  251.     TheForm.ScaleMode = OldMode
  252.     TheForm.DrawWidth = OldWidth
  253. End Sub
  254.  
  255. Sub DoPicture3D (ThePB As PictureBox, Style, thick, Distance)
  256. 'draws 3D shadow effects on a PictureBox
  257. 'can be called with different values for a variety of effects
  258. 'Style is either "sunken" or "raised"
  259. 'great for VB coded statusbars, etc.
  260.  
  261. 'use this function in the Paint event of the PictureBox
  262.     
  263.     If thick <= 0 Then thick = 1
  264.     If thick > 8 Then thick = 8
  265.     If Distance < 0 Then Distance = 0
  266.     If Distance > 8 Then Distance = 8
  267.     OldMode = ThePB.ScaleMode
  268.     OldWidth = ThePB.DrawWidth
  269.     ThePB.ScaleMode = 3
  270.     ThePB.DrawWidth = 1
  271.     FormHeight = ThePB.ScaleHeight
  272.     FormWidth = ThePB.ScaleWidth
  273.     FormLeft = ThePB.ScaleLeft
  274.     FormTop = ThePB.ScaleTop
  275.     
  276.     Select Case LCase$(Style)
  277.         Case "sunken":
  278.             TLshade = QBColor(8)
  279.             BRshade = QBColor(15)
  280.         Case "raised":
  281.             TLshade = QBColor(15)
  282.             BRshade = QBColor(8)
  283.         End Select
  284.     Select Case ThePB.BorderStyle
  285.         Case 0:
  286.             OLshade = QBColor(0)
  287.             ThePB.Line (0, 0)-(FormWidth, 0), OLshade
  288.             ThePB.Line (0, 0)-(0, FormHeight), OLshade
  289.             ThePB.Line (FormWidth - 1, 0)-(FormWidth - 1, FormHeight + 1), OLshade
  290.             ThePB.Line (0, FormHeight - 1)-(FormWidth, FormHeight - 1), OLshade
  291.             For i = 1 To thick
  292.                 CurLeft = FormLeft + i + Distance
  293.                 CurTop = FormTop + i + Distance
  294.                 CurWide = FormWidth - (i + Distance) * 2 - 1
  295.                 CurHigh = FormHeight - (i + Distance) * 2 - 1
  296.                 ThePB.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  297.                 ThePB.Line -Step(0, CurHigh), BRshade
  298.                 ThePB.Line -Step(-CurWide, 0), BRshade
  299.                 ThePB.Line -Step(0, -CurHigh), TLshade
  300.                 Next i
  301.         Case 1 To 3:
  302.             If Thickness = 1 Then
  303.                 ThePB.Line (thick, thick)-(FormWidth - thick, thick), TLshade
  304.                 ThePB.Line (thick, thick)-(thick, FormHeight - thick), TLshade
  305.                 ThePB.Line (FormWidth - thick, thick)-(FormWidth - thick, FormHeight - thick + 1), BRshade
  306.                 ThePB.Line (thick, FormHeight - thick)-(FormWidth - thick, FormHeight - thick), BRshade
  307.                 Else
  308.             For i = 1 To thick
  309.                 CurLeft = FormLeft + i - 1 + Distance
  310.                 CurTop = FormTop + i - 1 + Distance
  311.                 CurWide = FormWidth - (i + Distance) * 2 + 1
  312.                 CurHigh = FormHeight - (i + Distance) * 2 + 1
  313.                 ThePB.Line (CurLeft, CurTop)-Step(CurWide, 0), TLshade
  314.                 ThePB.Line -Step(0, CurHigh), BRshade
  315.                 ThePB.Line -Step(-CurWide, 0), BRshade
  316.                 ThePB.Line -Step(0, -CurHigh), TLshade
  317.                 Next i
  318.                 End If
  319.         End Select
  320.     ThePB.ScaleMode = OldMode
  321.     ThePB.DrawWidth = OldWidth
  322. End Sub
  323.  
  324. Sub FadeForm (TheForm As Form, FadeColor&, FadeDegree)
  325. 'draws a color-faded background on a form
  326. 'use this routine in the Paint event of a form
  327.  
  328. 'FadeColor& is the starting color to use
  329. '   QBcolor(1) or WordColor("blue") is common
  330. 'FadeDegree is the amount of fading to implement
  331. '   32 to 128 is normal; 64 is typical color fade
  332. '   the lower the value, the slower the fade
  333.  
  334.     Dim StepInterval As Integer
  335.     Dim RetVal       As Integer
  336.     Dim FillArea     As ObjRect
  337.     
  338.     OldMode% = TheForm.ScaleMode
  339.     TheForm.ScaleMode = 3
  340.     FormHeight% = TheForm.ScaleHeight
  341.     
  342.     sections% = FadeDegree
  343.     StepInterval = FormHeight% \ sections%
  344.     Red% = GetColorValue("red", FadeColor)
  345.     Green% = GetColorValue("green", FadeColor)
  346.     Blue% = GetColorValue("blue", FadeColor)
  347.     FillArea.Left = 0
  348.     FillArea.right = TheForm.ScaleWidth
  349.     FillArea.Top = 0
  350.     FillArea.bottom = StepInterval
  351.     
  352.     For x = 0 To sections%
  353.        hBrush% = CreateSolidBrush(RGB(Red%, Green%, Blue%))
  354.        RetVal = FillRect(TheForm.hDC, FillArea, hBrush%)
  355.        RetVal = AltDeleteObject(hBrush%)
  356.        If Red% <> 0 Then
  357.             Red% = Red% - 4: If Red% < 0 Then Red% = 0
  358.             End If
  359.        If Green% <> 0 Then
  360.             Green% = Green% - 4: If Green% < 0 Then Green% = 0
  361.             End If
  362.        If Blue% <> 0 Then
  363.             Blue% = Blue% - 4: If Blue% < 0 Then Blue% = 0
  364.             End If
  365.        FillArea.Top = FillArea.bottom
  366.        FillArea.bottom = FillArea.bottom + StepInterval + 1
  367.     Next
  368.     
  369.     TheForm.ScaleMode = OldMode%
  370. End Sub
  371.  
  372. Sub FormBLscreen (TheForm As Form)
  373.     If TheForm.WindowState = 0 Then
  374.         BotPos = Screen.Height - TheForm.Height
  375.         TheForm.Move (0), (BotPos)
  376.         End If
  377. End Sub
  378.  
  379. Sub FormBRscreen (TheForm As Form)
  380.     If TheForm.WindowState = 0 Then
  381.         BotPos = Screen.Height - TheForm.Height
  382.         RightPos = Screen.Width - TheForm.Width
  383.         TheForm.Move (RightPos), (BotPos)
  384.         End If
  385. End Sub
  386.  
  387. Sub FormCenterForm (TheForm As Form, MainForm As Form)
  388. 'centers one (nonMDIchild) form within another form
  389.  
  390.     If TheForm.WindowState = 0 Then
  391.         TheForm.Move MainForm.Left + (MainForm.Width - TheForm.Width) / 2, MainForm.Top + (MainForm.Height - TheForm.Height) / 2
  392.         End If
  393. End Sub
  394.  
  395. Sub FormCenterScreen (TheForm As Form)
  396. 'centers a form on the screen
  397. 'great for primary form and modal forms
  398.     
  399.     If TheForm.WindowState = 0 Then
  400.         TheForm.Move (Screen.Width - TheForm.Width) / 2, (Screen.Height - TheForm.Height) / 2
  401.         End If
  402. End Sub
  403.  
  404. Sub FormTLscreen (TheForm As Form)
  405.     If TheForm.WindowState = 0 Then TheForm.Move (0), (0)
  406. End Sub
  407.  
  408. Sub FormTRscreen (TheForm As Form)
  409.     If TheForm.WindowState = 0 Then
  410.         RightPos = Screen.Width - TheForm.Width
  411.         TheForm.Move (RightPos), (0)
  412.         End If
  413. End Sub
  414.  
  415. Sub ShowForm (TheForm As Form, Style, FillColor&, SpeedFactor)
  416. 'displays a form in stylized fashion
  417. 'set the form's color (in design mode) to the same value as FillColor&
  418.  
  419. 'Style="CenterOut", "CenterDown", or "LeftDown"
  420. 'the higher the speed facter, the slower the dispay
  421. '   use 1 - 10 for best results
  422.     
  423.     Dim FormRect As ObjRect
  424.     GetWindowRect TheForm.hWnd, FormRect
  425.     FullWidth = FormRect.right - FormRect.Left
  426.     FullHeight = FormRect.bottom - FormRect.Top
  427.     ScreenHDC% = GetDC(0)
  428.     hBrush% = CreateSolidBrush(FillColor)
  429.     OldBrushHndl% = SelectObject(ScreenHDC%, hBrush%)
  430.     
  431.     speed = SpeedFactor * 25
  432.     For index = 1 To speed
  433.         xx% = FullWidth * (index / speed)
  434.         yy% = FullHeight * (index / speed)
  435.         Select Case LCase$(Style)
  436.             Case "center outward"
  437.                 x% = FormRect.Left + (FullWidth - xx%) / 2
  438.                 y% = FormRect.Top + (FullHeight - yy%) / 2
  439.             Case "center downward"
  440.                 x% = FormRect.Left + (FullWidth - xx%) / 2
  441.                 y% = FormRect.Top
  442.             Case "left downward"
  443.                 x% = FormRect.Left
  444.                 y% = FormRect.Top
  445.                 End Select
  446.         Rectangle ScreenHDC%, x%, y%, x% + xx%, y% + yy%
  447.     Next index
  448.     ret% = ReleaseDC(0, ScreenHDC%)
  449.     DeleteObject (hBrush%)
  450.     TheForm.Visible = True
  451. End Sub
  452.  
  453.